home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / SM / SMPrefs / SMPrefs.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  10KB  |  343 lines
  1. Program SMPrefs(input, output);
  2.  
  3. {$F+,I-,R-,S-,V-,M 4,1,2,15}
  4.  
  5. Uses Exec, Intuition, utility, gadtools, graphics, DiskFont, 
  6. ASL, AmigaDOS, Amiga, IFFParse, ReqTools, Input, DOS, Datatypes, Modeid;
  7.  
  8. {$I SMPrefs.h }
  9.  
  10.  
  11. { Init the global CData structure, what does the C stand for?? }   
  12. Procedure InitCD;
  13.  
  14. begin
  15.     CD.cd_FontName      := 'topaz.font'#0;
  16.     CD.cd_Font.ta_Name  := @CD.cd_FontName[1];
  17.     CD.cd_Font.ta_YSize := 8;
  18.     CD.cd_Font.ta_Style := FS_NORMAL;
  19.     CD.cd_Font.ta_Flags := FPF_ROMFONT;
  20.     CD.cd_SFont := CD.cd_Font;
  21.     CD.cd_SFontName     := 'topaz.font'#0;
  22.     CD.cd_SFont.ta_Name  := @CD.cd_SFontName[1];
  23.     CD.cd_ModeID        := HIRES_KEY;
  24.     if (GfxBase^.DisplayFlags and NTSC) = NTSC then
  25.         CD.cd_ModeID      := NTSC_MONITOR_ID|HIRES_KEY;
  26.     if (GfxBase^.DisplayFlags and PAL) = PAL then
  27.         CD.cd_ModeID      := PAL_MONITOR_ID|HIRES_KEY; 
  28.     CD.cd_Across        := 1;
  29.     CD.cd_Down          := 1;
  30.     CD.cd_ScrTit        := 'Startup-Menu ©Lee Kindness';
  31.     CD.cd_WinTit        := 'Pick One...'; 
  32.     CD.cd_Pal[0]        := $AAA;
  33.     CD.cd_Pal[1]        := $000;
  34.     CD.cd_Pal[2]        := $FFF;
  35.     CD.cd_Pal[3]        := $CB4;
  36.     CD.cd_ScrW          := 640;
  37.     CD.cd_ScrH          := 200;
  38.     CD.cd_WitTxt        := '';
  39.     CD.cd_RexxCmd1      := 'id SM_INITIAL';
  40.     CD.cd_Rexxport1     := 'PLAY';
  41.     CD.cd_RexxCmd2      := 'id SM_EXIT';
  42.     CD.cd_RexxPort2     := 'PLAY';
  43.     CD.cd_RexxCmd3      := 'id SM_PRECMD';
  44.     CD.cd_RexxPort3     := 'PLAY';
  45.     CD.cd_Wit           := True;
  46.     CD.cd_Rexx          := True;
  47.     CD.cd_ScrT          := 0;
  48.     CD.cd_WildStar      := False;
  49.     CD.cd_Shanghai      := True;
  50.     CD.cd_PopPubScr     := True;
  51.     CD.cd_Quals         := 0;
  52.     CD.cd_Wait          := 0;
  53.     CD.cd_Flush         := True;
  54.     CD.cd_Test          := False;
  55.     CD.cd_DT            := '';
  56.     CD.cd_DTImmed       := True;
  57.     CD.cd_DTRepeat      := True;
  58.     CD.cd_ScrDepth      := 2;
  59.     CD.cd_NoClick       := True;
  60.     CD.cd_App           := APP_ALL;
  61. end;
  62.  
  63. { close the window and free related structures }
  64. Procedure Close_Window;
  65.  
  66. Begin
  67.     if MenuStrip <> NIL then begin
  68.         ClearMenuStrip(TheWindow);
  69.         FreeMenus(MenuStrip);
  70.     end;
  71.     CloseWindow(TheWindow);
  72.     FreeGadgets(gads[G_NI]);
  73.     FreeVisualInfo(vi);
  74. End;
  75.  
  76. { The main IDCMP loop }
  77. Procedure HandleIDCMP;
  78.  
  79. Const
  80.     exitflag : Boolean  = False; 
  81.     small    : Boolean  = False;
  82.     CurrentSecs : Long = 0;
  83.     CurrentMics : Long = 0;
  84.     NewSecs : Long = 0;
  85.     NewMics : Long = 0;
  86.    
  87. Var 
  88.     dummy      : longint;
  89.     Tags       : Array[0..8] Of tTagItem;
  90.     message    : pIntuiMessage;
  91.     MsgClass, osm, oss : LongInt;
  92.     MsgCode    : Word;
  93.     gadcode    : pGadget;
  94.     StrInfo    : pStringInfo;
  95.     OKRes,cont : boolean;
  96.     i          : Longint;
  97.     lr, sr     : pFileRequester;
  98.     cfile, cdir: String;
  99.     t          : array[0..1] of tTagItem;
  100.     menunumber,INum, MNum : Word;
  101.     Item       : pMenuItem;
  102.     
  103.  
  104. Procedure InfoGadFunc; Forward;
  105. Procedure GetTitles; Forward;
  106. Procedure GetPal; Forward;
  107. Function GetSCRID : LongInt; Forward;
  108. Procedure TopGadFunc; Forward;
  109. Procedure UpGadFunc; Forward;
  110. Procedure DownGadFunc; Forward;
  111. Procedure BottomGadFunc; Forward;
  112. Procedure NewGadFunc; Forward;
  113. Procedure RemoveGadFunc; Forward;
  114. Procedure CopyGadFunc; Forward;
  115. Procedure SaveGadFunc; Forward;
  116. Procedure SaveAsGadFunc; Forward;
  117. Procedure NewListFunc; Forward;
  118. Procedure LoadGadFunc; Forward;
  119. Procedure LVGadFunc; Forward;
  120. Procedure FontGadFunc(Scroll : Boolean); Forward;
  121. Procedure TestGadFunc; Forward;
  122. {$I IDCMP.PAS }
  123.  
  124. Begin
  125.     osm := 0;
  126.     oss := 0;
  127.     currentnode := NIL;
  128.     Tags[0].ti_Tag  := ASLFR_TitleText;
  129.     Tags[0].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Locate the prefs file'));
  130.     Tags[1].ti_Tag  := ASLFR_InitialFile;
  131.     Tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, PREFSNAME));
  132.     Tags[2].ti_Tag  := ASLFR_InitialDrawer;
  133.     Tags[2].ti_Data := long(CStrConstPtrAR(@RememberKey, PREFSDIRH));
  134.     Tags[3].ti_Tag  := ASLFR_Window;
  135.     Tags[3].ti_Data := long(TheWindow);
  136.     Tags[4].ti_Tag  := ASLFR_Flags2;
  137.     Tags[4].ti_Data := FRF_REJECTICONS;
  138.     Tags[5].ti_Tag  := ASLFR_Flags1;
  139.     Tags[5].ti_Data := FRF_DOPATTERNS;
  140.     Tags[6].ti_Tag  := ASLFR_InitialPattern;
  141.     Tags[6].ti_Data := LONG(CStrConstPtrAR(@RememberKey, '#?.prefs'));
  142.     Tags[7].ti_Tag  := TAG_DONE;
  143.  
  144.     lr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  145.     
  146.     Tags[0].ti_Tag  := ASLFR_TitleText;
  147.     Tags[0].ti_Data := LONG(CStrConstPtrAR(@RememberKey, 'Save prefs file as'));
  148.     Tags[1].ti_Tag  := ASLFR_InitialFile;
  149.     Tags[1].ti_Data := LONG(CStrConstPtrAR(@RememberKey, PREFSNAME));
  150.     Tags[2].ti_Tag  := ASLFR_InitialDrawer;
  151.     Tags[2].ti_Data := long(CStrConstPtrAR(@RememberKey, PREFSDIRH));
  152.     Tags[3].ti_Tag  := ASLFR_Window;
  153.     Tags[3].ti_Data := long(TheWindow);
  154.     Tags[4].ti_Tag  := ASLFR_Flags2;
  155.     Tags[4].ti_Data := FRF_REJECTICONS;
  156.     Tags[5].ti_Tag  := TAG_DONE;
  157.     
  158.     sr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  159.  
  160.     t[0].ti_Tag  := RT_Window;
  161.     t[0].ti_Data := LONG(TheWindow);
  162.     t[1].ti_Tag  := TAG_END;
  163.     
  164.     While Not exitflag Do Begin
  165.         dummy    := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
  166.         message  := GT_GetIMsg(TheWindow^.userPort);
  167.         While message <> NIL do begin
  168.             MsgClass := message^.Class;
  169.             MsgCode  := message^.Code;
  170.             if MsgClass = IDCMP_GADGETUP then begin
  171.                 GadCode  := pGadget(message^.IAddress);
  172.                 StrInfo  := gadcode^.SpecialInfo;
  173.             end;
  174.             NewSecs  := message^.Seconds;
  175.             NewMics  := message^.Micros;
  176.             GT_ReplyIMsg(message);
  177.             Case MsgClass Of
  178.             
  179.                 IDCMP_CLOSEWINDOW : ExitFlag := True;
  180.                     
  181.                 IDCMP_REFRESHWINDOW : RefreshWin(TheWindow);
  182.                     
  183.                 IDCMP_MENUPICK : Begin
  184.                     MenuNumber := MsgCode;
  185.                     While (menunumber <> MENUNULL) and (ExitFlag = False) do begin
  186.                         Item := ItemAddress(MenuStrip, menunumber); 
  187.                         MNum := MENUNUM(menunumber);  
  188.                         INum := ITEMNUM(menunumber);
  189.                         CASE MNum of 
  190.                             MM_PROJ : begin
  191.                                 CASE INum of
  192.                                     MI_OPEN : LoadGadFunc;
  193.                                     MI_SAVA : SaveAsGadFunc;
  194.                                     MI_TEST : TestGadFunc;
  195.                                     MI_INFO : InfoGadFunc;
  196.                                     MI_QUIT : ExitFlag := True;
  197.                                 End;
  198.                             End;
  199.                             MM_EDIT : begin
  200.                                 Case INum of
  201.                                     MI_RDEF : NewListFunc;
  202.                                     MI_REST : begin
  203.                                         DetachObjectList;
  204.                                         OKRes := ReadConfigFile('S:Startup-Menu.prefs');
  205.                                         if OKRes then begin  
  206.                                             CurrentNode := NIL;
  207.                                             CurrentOrd := -1;
  208.                                             currenttop := 0;
  209.                                             DisableObjectGadgets(TRUE_);
  210.                                         end else begin
  211.                                             DisplayBeep(NIL);
  212.                                             NewListFunc;
  213.                                         End;
  214.                                         AttachObjectList;
  215.                                     End;
  216.                                 End;
  217.                             End;
  218.                         end;
  219.                         menunumber := item^.NextSelect;
  220.                     end;
  221.                 end;       
  222.                     
  223.                 IDCMP_GADGETUP : Begin       
  224.                     Case gadcode^.GadgetID Of         
  225.                         G_B_TOP     : TopGadFunc;
  226.                         G_B_UP      : UpGadFunc;
  227.                         G_B_DOWN    : DownGadFunc;
  228.                         G_B_BOTTOM  : BottomGadFunc;
  229.                         G_B_SORT    : SortGadgetFunc;
  230.                         G_B_NEW     : NewGadFunc;
  231.                         G_B_REMOVE  : RemoveGadFunc;
  232.                         G_B_COPY    : CopyGadFunc;
  233.                         G_B_SAVE    : SaveGadFunc;
  234.                         G_B_CANCEL  : exitflag := True;                               
  235.                         G_LV        : LVGadFunc;
  236.                         G_C_SET     : begin
  237.                             If DoubleClick(oss, osm, NewSecs, NewMics) then begin
  238.                                 if MsgCode = CurSet then begin
  239.                                     Case curset of 
  240.                                         C_REXX : Begin
  241.                                             wl := Pointer(rtLockWindow(TheWindow));
  242.                                             RexxEDWin(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS], 
  243.                                                 CD.cd_RexxCmd1,CD.cd_RexxPort1,
  244.                                                 CD.cd_RexxCmd2,CD.cd_RexxPort2,
  245.                                                 CD.cd_RexxCmd3,CD.cd_RexxPort3, CD.cd_Rexx);
  246.                                             rtUnLockWindow(TheWindow, wl);
  247.                                         end;
  248.                                         C_FONT : FontGadFunc(false);
  249.                                         C_PALT : GetPal;
  250.                                         C_QUAL : Begin          
  251.                                             wl := Pointer(rtLockWindow(TheWindow));
  252.                                             QualWin(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS]);
  253.                                             rtUnLockWindow(TheWindow, wl);
  254.                                         end;
  255.                                         C_SCRN : Begin          
  256.                                             wl := Pointer(rtLockWindow(TheWindow));
  257.                                             SWWindow(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS]);
  258.                                             rtUnLockWindow(TheWindow, wl);
  259.                                         end;
  260.                                         C_SMID : CD.cd_ModeID := GetSCRID;
  261.                                         C_SFNT : FontGadFunc(true);
  262.                                         C_SYSS : Begin          
  263.                                             wl := Pointer(rtLockWindow(TheWindow));
  264.                                             SysOptWin(TheWindow^.LeftEdge+5, TheWindow^.TopEdge+Sizes[TBS]);
  265.                                             rtUnLockWindow(TheWindow, wl);
  266.                                         end;
  267.                                         C_TITL : GetTitles;
  268.                                     End;
  269.                                 End;
  270.                             End;
  271.                             CurSet := MsgCode;
  272.                             oss := NewSecs;
  273.                             osm := NewMics;
  274.                         End;
  275.                     End; {case}
  276.                 end;
  277.                
  278.                 IDCMP_VANILLAKEY : begin
  279.                     case chr(msgcode) of
  280.                         'N','n' : NewGadFunc;
  281.                         'T','t' : TopGadFunc;
  282.                         'U','u' : UpGadFunc;
  283.                         'W','w' : DownGadFunc;
  284.                         'B','b' : BottomGadFunc;
  285.                         'V','v' : RemoveGadFunc;
  286.                         'Y','y' : CopyGadFunc;
  287.                         'S','s' : SaveGadFunc;
  288.                         'C','c' : exitflag := True;
  289.                     end;
  290.                 end; 
  291.             End; {case}
  292.             message  := GT_GetIMsg(TheWindow^.userPort);
  293.         End;
  294.     End; {while}
  295.        
  296.     FreeAslRequest(lr);
  297.     FreeAslRequest(sr);
  298. End;
  299.     
  300. { ===================================================================== }
  301.     
  302.     { 
  303.      * Main Procedure 
  304.      }
  305.     
  306. Procedure main;
  307.     
  308. VAR
  309.     nl, oldlock : BPTR;
  310.     
  311. Begin
  312.     If Open_Libs then begin
  313.         If pExecBase(SysBase)^.LibNode.lib_Version >= 39 then 
  314.             V39 := True
  315.         else
  316.             V39 := False;
  317.      
  318.         nl := Lock(CStrConstPtrAR(@RememberKey, PREFSDIRH), ACCESS_READ);
  319.         oldlock := currentdir(nl);
  320.     
  321.         if NOT ReadConfigFile(PREFSNAME) then begin
  322.             currentlist := pList(AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR|MEMF_PUBLIC));
  323.             newlist(currentlist);
  324.             InitCD;  
  325.         end;
  326.         CurrentNode := NIL;
  327.         oldlock := currentdir(oldlock);
  328.         unlock(nl);
  329.            
  330.         if Open_Window then begin
  331.             HandleIDCMP;
  332.             Close_window;
  333.         end;
  334.         FreeRemember(@RememberKey, True);
  335.     end;
  336.     Close_Libs;
  337. end;
  338.     
  339. { ===================================================================== }  
  340. begin
  341. main; 
  342. end.
  343. { ===================================================================== }